Delphi Programmer's Power Pack/Delphi Volume 1.iso/s_to_z/spidr100/setup.arv/LISTTEST.PAS

Pascal/Delphi Source File | 1996-09-15 | 9.4 KB | 374 lines

{----------------------------------------------------------------------------
|
| Library: Spider Containers for Object Pascal
|
| Module: ListTest.Pas
|
| Description: Form for TNodeContainer and derived classes test.
|
| History: Version 1.0  March 1996. Copyright (c) 1996 Michel Brazeau
|                                   Interval Software
|
|---------------------------------------------------------------------------}
unit ListTest;

interface

uses

  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls,

  ObjBase;  { TNodeContainer }

const
    { list indexes related to ListTypeCombo's ItemIndex property. The
      strings in ListTypeCombo were set at design time matching these
      constants }
    liUnOrderedList = 0;
    liOrderedList   = 1;
    liBinaryTree    = 2;

type
  TListIndex = liUnOrderedList .. liBinaryTree;

type
  TNodeContainerForm = class(TForm)
    AddRandomButton: TButton;
    RemoveButton: TButton;
    ClearButton: TButton;
    ListBox: TListBox;
    ListTypeCombo: TComboBox;
    ItemCount: TLabel;
    AddButton: TButton;
    Load: TButton;
    SearchButton: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure RemoveButtonClick(Sender: TObject);
    procedure AddRandomButtonClick(Sender: TObject);
    procedure ClearButtonClick(Sender: TObject);
    procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure FormCreate(Sender: TObject);
    procedure ListTypeComboChange(Sender: TObject);
    procedure AddButtonClick(Sender: TObject);
    procedure LoadClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure SearchButtonClick(Sender: TObject);

  private
     List : TNodeContainer;

     { returns the combo box index represented by the current list
       type. }
     function CurrentListIndex : TListIndex;

     { creates the List data member given the list type }
     procedure CreateList(Index : TListIndex);

     { updates the ItemCount lable from the List.Size }
     procedure UpdateItemCount;

     { add a value to the list }
     procedure AddValue(Value : Word);

end;

{--------------------------------------------------------------------------}

implementation

{$R *.DFM}

uses
      ObjTest,     { GetRandomValue }
      ObjBuckt,    { TBucket }
      ObjList,     { TOrderedDblList }
      ObjBTree;    { TBinaryTree }


{--------------------------------------------------------------------------}

procedure TNodeContainerForm.FormCreate(Sender: TObject);
begin
    { by default, create an unordered list }
    CreateList(liUnOrderedList);

    ListTypeCombo.ItemIndex := liUnorderedList;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.FormDestroy(Sender: TObject);
begin
    List.Free;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.AddValue(Value : Word);
var
    Bucket : TWordBucket;
begin
    Bucket := TWordBucket.Create(Value);
    try
        ListBox.Enabled := False;
        try
            ListBox.Items.AddObject('', nil);
            try
                List.Insert(Bucket);
            except
                ListBox.Items.Delete(ListBox.Items.Count-1);
                raise;
            end;
        finally
            ListBox.Enabled := True;
        end;
    except
        Bucket.Free;
        raise;
    end;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.AddRandomButtonClick(Sender: TObject);
begin
    AddValue(GetRandomNumber);

    ListBox.ItemIndex := ListBox.Items.Count - 1;

    UpdateItemCount;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.RemoveButtonClick(Sender: TObject);
var
    Item : LongInt;  { 0 based item index }

begin
    Item := ListBox.ItemIndex;

    if Item <= -1 then
        Exit;  { no item is selected, since ItemIndex = -1 when no item is
                 selected }

    ListBox.Enabled := False;

    List.GotoNth(Item+1);
    List.DeleteCurrent;

    try
        ListBox.Items.Delete(Item);

        { keep an item selected, convert from 1 based to 0 based }
        if ListBox.Items.Count <= Item then
            ListBox.ItemIndex := Item - 1
        else
            ListBox.ItemIndex := Item;
    finally
        ListBox.Enabled := True;
    end;

    UpdateItemCount;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.ClearButtonClick(Sender: TObject);
begin
    { clear the list box }
    ListBox.Clear;

    { clear the node container }
    List.Clear;

    UpdateItemCount;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.ListBoxDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
begin
    with (Control as TListBox).Canvas do
    begin
        FillRect(Rect);    { clear the rectangle }

        TextOut( Rect.Left + 2, Rect.Top,
                 IntToStr((List[Index+1] as TWordBucket).Value))
    end; { with }
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.ListTypeComboChange(Sender: TObject);
var
    CurIndex : Word;
begin
    CurIndex := CurrentListIndex;

    with Sender as TComboBox do
    begin
        if ItemIndex <> CurIndex then
        begin
            List.Free;

            CreateList(ItemIndex);

            ListBox.Clear;

            UpdateItemCount;
        end;
    end;
end;

{--------------------------------------------------------------------------}

function TNodeContainerForm.CurrentListIndex : TListIndex;
begin
    if List is TUnorderedList then
        Result := liUnorderedList
    else if List is TOrderedList then
        Result := liOrderedList
    else
        Result := liBinaryTree;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.CreateList(Index : TListIndex);
begin
    case Index of
    liUnOrderedList : List := TUnOrderedList.Create(TWordBucket, CompareWordBucket);
    liOrderedList   : List := TOrderedList.Create(TWordBucket, CompareWordBucket);
    liBinaryTree    : List := TBinaryTree.Create(TWordBucket, CompareWordBucket);
    end; { case }
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.UpdateItemCount;
begin
    ItemCount.Caption := IntToStr(List.Size);
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.AddButtonClick(Sender: TObject);
const
    NumStr : String = '0';

begin
    if not InputQuery('', 'Value to add: ', NumStr) then
        Exit;

    AddValue(StrToInt(NumStr));

    ListBox.ItemIndex := ListBox.Items.Count - 1;

    UpdateItemCount;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.LoadClick(Sender: TObject);
var
    NumberList : TUnorderedList;

    WordBucket : TWordBucket;

    Value      : Word;

    I          : LongInt;

begin
    NumberList := TUnOrderedList.Create(TWordBucket, CompareWordBucket);
    try
        ListBox.Enabled := False;

        TestForm.LoadNumbersFromFile(NumberList);

        Screen.Cursor := crHourGlass;

        try
            I := 1;

            { insert all the values in NumberList }
            if NumberList.GotoFirst then
            repeat
                { give other applications processing time }
                if (I mod 500) = 0 then
                    Application.ProcessMessages;
                Inc(I);

                Value := (NumberList.CurrentObj as TWordBucket).Value;

                WordBucket := TWordBucket.Create(Value);

                AddValue(Value);

           until not NumberList.GotoNext;

        finally
            Screen.Cursor := crDefault;

            ListBox.Enabled := True;
        end;

    finally
        NumberList.Free;

        ListBox.ItemIndex := ListBox.Items.Count - 1;

        UpdateItemCount;
    end;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
    Action := caFree;
end;

{--------------------------------------------------------------------------}

procedure TNodeContainerForm.SearchButtonClick(Sender: TObject);
const
    NumberStr : String = '0';

    OccurStr  : String = '1';

var
    Occur     : LongInt;

    Bucket    : TWordBucket;

begin
    if not InputQuery('', 'Search for : ', NumberStr) then
        Exit;

    if not InputQuery('', 'Occurence : ', OccurStr) then
        Exit;

    Occur := StrtoInt(OccurStr);

    Bucket := TWordBucket.Create(StrToInt(NumberStr));
    try
        if List.Search(Bucket, Occur) then
            MessageDlg('Value found', mtInformation,[mbOk], 0)
        else
            MessageDlg('Value NOT found!', mtInformation,[mbOk], 0);

    finally
        Bucket.Free;
    end;
end;

{--------------------------------------------------------------------------}

end.